home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ciarnv85.arc / H4.4TH < prev    next >
Text File  |  1986-04-08  |  2KB  |  66 lines
  1. HEX
  2.  
  3.  VARIABLE COUNTER
  4.  VARIABLE EPSILON
  5.  VARIABLE LOWF  VARIABLE HIF
  6. : TONE 0 COUNTER !
  7.  ( THIS ROUTINE MAY NEED SOME WORK )
  8. BEGIN RGT
  9.  DUP LOWF @ < IF
  10.   DUP 0= IF DROP 1 COUNTER +! RGT THEN
  11.   DUP LOWF ! THEN
  12.  DUP DUP HIF @ > IF HIF ! LOWF @ ELSE DROP HIF @ THEN
  13.  HIF @ LOWF @ - EPSILON @ <
  14. COUNTER @ 64 < AND WHILE
  15. 1 COUNTER +! DROP DROP REPEAT
  16. SWAP DUP LOWF ! HIF ! COUNTER @ ;
  17. CTAG
  18. : PTONE BEGIN TONE ." ( " . . ." )    " 0 UNTIL ;
  19.  VARIABLE ERRCNT
  20.  VARIABLE XNUM
  21.  VARIABLE RNUM
  22. DI
  23. : RANDC 47 * 17 + 255 AND ; ( RANDOM # 0 TO 255 )
  24. HEX
  25. : SEND XNUM C@ RANDC DUP XNUM C! DA! ;
  26. : RECEV DA@ DUP RNUM C@ RANDC = IF
  27.  ELSE 1 ERRCNT +! THEN RNUM C! ;
  28.  
  29. : SEED 0 RNUM ! BEGIN ?KEY
  30.  CT@ DUP XR AND IF SEND THEN
  31.  BEGIN RECEV RNUM @ UNTIL UNTIL ;
  32. : FTEST 400 0 DO ?KEY CT@ DUP XR AND IF SEND THEN
  33.  RR AND IF RECEV THEN LOOP ;
  34. : FACT BEGIN ?KEY SEED FTEST ERRCNT @ . AGAIN ;
  35.  
  36. : PINIT TONE DROP DROP ;
  37. : CYCLE PINIT TONE TONE OVER EPSILON @ < IF ELSE 2SWAP THEN ;
  38.  ( ONFREQ C OFFREQ C )
  39.  VARIABLE FLAG
  40. CTAG
  41. DI
  42. CREATE BOUNDS 3 C, 7 C, 15 C, 18 C, 25 C, 30 C, 90 C,
  43. CREATE CODES 63 C, 79 C, 66 C, 63 C, 98 C, 63 C, 82 C,
  44. : PROGM ( PROGRESS MON ) 1 FLAG ! CYCLE
  45.  ROT + ( SUM OF COUNTS )
  46. 7 0 DO DUP BOUNDS I + C@
  47.  < IF CODES I + C@ EMIT CR 0 FLAG ! LEAVE THEN
  48. LOOP DROP
  49. FLAG @ IF 2DUP EPSILON @ <
  50.  
  51.  SWAP EPSILON @ < AND IF DROP DROP
  52.  ELSE - ABS EPSILON @ < IF 68 EMIT CR ELSE 86 EMIT CR THEN
  53. THEN THEN ;
  54. HEX
  55. ( HARDWARE DEBUG COMMANDS )
  56. : STT BEGIN CT@ . ?KEY AGAIN ;
  57. : CTT BEGIN DUP CT! ?KEY AGAIN ;
  58. : DAR BEGIN DA@ . ?KEY AGAIN ;
  59. : DAW BEGIN DUP DA! ?KEY AGAIN ;
  60. : XINIT 0 CT! 0 CT!
  61.   BEGIN 40 CT! DOVER DOVER CT! CT! CT! CT! ?KEY AGAIN ;
  62.  
  63. CTAG
  64. ==> B:CALC.4TH     
  65.  
  66.